home *** CD-ROM | disk | FTP | other *** search
/ Run Magazine ReRun: Productivity Pak 3 / rerun-productivity-pak-iii-side-a.d64 / runfile 64.bas (.txt) < prev    next >
Commodore BASIC  |  2022-09-20  |  18KB  |  622 lines
  1. 10 rem *************************
  2. 20 rem program : runfile 1.0
  3. 30 rem author  : david darus
  4. 40 rem date    : 6/15/87
  5. 50 rem update  : 7/30/87
  6. 60 rem computer: c64
  7. 70 rem *************************
  8. 80 rem command file=1 seq file=2 rel file=3
  9. 90 rem set up variables
  10. 98 dn=8
  11. 100 def fnh(a)=int(a/256):def fnl(a)=a-(rh*256)
  12. 110 print"[147][154]"chr$(8)chr$(14)
  13. 140 x=0:y=0:sw=0:c=0:t=0:t1=0:nc=0:hc=0:cc=0:ec=0:a=0:l=0:en=0:tr=0:sc=0:nf=0
  14. 150 fc=0:nd=0:fl=0:tx=0:ty=0:ox=0:oy=0:nm=0:al=0:ky=0:sp=0:vn=0:tl=0:pl=0:ct=0
  15. 160 ef=0:mr=0:nl=0:rn=0:nr=0:of=0                           
  16. 165 f1=133:f3=134:f5=135:f7=136:f2=137:f4=138:f6=139:f8=140
  17. 170 rl=0:rh=0:rs=0:re=0:rm=0:ip=0:kf=0:kl=0:kp=0:rp=0:r$="":r1$="":ky$=""
  18. 180 cm$="":sp$="":a$="":an$="":er$="":dn$="":ss$="":xp$="":yp$=""
  19. 190 for t=1 to 80:xp$=xp$+"":yp$=yp$+"":sp$=sp$+" ":ul$=ul$+"[164]":next
  20. 200 ss$=chr$(160):pd$=""
  21. 210 c=1:hc=2:cc=15:nc=6:ns=6:ec=8:of=0
  22. 220 nl=22:vn=0:rn=0
  23. 230 sw=40:mr=1000:ct=0:poke 53280,0:poke 53281,0:poke 808,234:goto 280
  24. 240 rem sw=40:mr=2000:ct=1:slow:rem trap 21000
  25. 250 if peek(215)=128 then sw=80:(NULL)%
  26. 270 (NULL)0,1:(NULL)1,1:(NULL)4,1:(NULL)6,1:(NULL)5,15
  27. 272 (NULL)1,chr$(133):(NULL)3,chr$(134):(NULL)5,chr$(135):(NULL)7,chr$(136)
  28. 274 (NULL)2,chr$(137):(NULL)4,chr$(138):(NULL)6,chr$(139):(NULL)8,chr$(140)
  29. 280 dimcr$(16),cx(nc),cy(nc),cm$(nc),tx$(18),fl$(nl),sx(ns),sy(ns),sm$(ns)
  30. 290 mf=30:a=mf+1:dim fx(a),fy(a),fl(a),ft(a),ft$(a),fq(a),fo(a)
  31. 300 dim ix(mr),rd$(mr),si(mr)
  32. 310 fort=1to16:cr$(t)=mid$("[144][159][156][158][129][149][150][151][152][153][154][155]",t,1):next
  33. 320 cm$="[195][207][205][205][193][206][196][211]:[154] [195]lose [197]dit [206]ew [207]pen [213]tils e[216]it"
  34. 330 fort=1 to nc:read cy(t),cx(t),cm$(t):next
  35. 340 data 23,10,"[195]lose",23,16,"[197]dit",23,21,"[206]ew",23,25,"[207]pen",23,30,"[213]tils"
  36. 350 data 23,36,"e[216]it"
  37. 352 sm$="[213][212][201][204][211]:[154] [196]ir [196]os [196]rive#08 [208]rint [211]eq [213]sr"
  38. 353 for t=1 to ns:read sy(t),sx(t),sm$(t):next
  39. 354 data 23,7,"[196]ir",23,11,"[196]os",23,15,"[196]rive#08",23,24,"[208]rint",23,30,"[211]eq"
  40. 355 data 23,34,"[213]sr"
  41. 360 for t=1 to 18:read tx$(t):next
  42. 370 data "[210]un [198]ile 1.0","[196]atabase:","[204]en=","[212]ype:","[193]lpha","[203]ey","[206]um"
  43. 380 data "[211]pecial","[211]earching for field","[198]ile:","[212]otal="
  44. 390 data "[197]stimated # of records","[204]oading database parameters"
  45. 392 data " "
  46. 394 data "[211]elect fields in desired export order   "
  47. 396 data "[211]ort (y/n)","[210]eplace record (y/n)","#recs"
  48. 400 rem set up screen
  49. 410 print"[147]":x=0:y=22:gosub2210
  50. 420 printcr$(ec);:for t=1 to sw:print"[192]";:next:x=0:gosub2210:printtx$(1);
  51. 430 x=0:y=23:gosub2210:printcm$;
  52. 440 rem get commands
  53. 450 c=1:gosub 5110
  54. 460 x=cx(c):y=cy(c):gosub2210:print""cr$(hc);cm$(c);"[146]";
  55. 470 geta$:ifa$=""then470
  56. 480 x=cx(c):y=cy(c):gosub2210:printcr$(cc);cm$(c);
  57. 490 ifa$=chr$(13)then660
  58. 500 ifa$=""then600
  59. 510 ifa$="[157]"then630
  60. 520 ifa$="c"then710
  61. 530 ifa$="e"then810
  62. 540 ifa$="n"then1110
  63. 550 ifa$="o"then1210
  64. 560 ifa$="u"then1610
  65. 570 ifa$="x"then1710
  66. 580 goto460
  67. 590 rem cursor right
  68. 600 c=c+1:ifc>ncthenc=1
  69. 610 goto460
  70. 620 rem cursor left
  71. 630 c=c-1:ifc<1thenc=nc
  72. 640 goto460
  73. 650 rem return
  74. 660 on c goto 710,810,1110,1210,1610,1710:goto470
  75. 700 rem close database
  76. 710 if of=0 then 450
  77. 715 open 1,dn,15,"i":print#1,"s:\\temp.i":close1
  78. 720 of=0:open 2,dn,2,"\\temp.i,u,w":nr=ix(0)
  79. 730 rh=fnh(nr):rl=fnl(nr):print#2,"indx";chr$(vn);chr$(rl);chr$(rh);
  80. 740 if nr=0 then 760
  81. 750 for t=1 to nr:rh=fnh(ix(t)):rl=fnl(ix(t)):print#2,chr$(rl);chr$(rh);:next
  82. 760 close2
  83. 770 open1,dn,15,"s:"+dn$+"bi":print#1,"r:"+dn$+"bi="+dn$+".i"
  84. 780 print#1,"r:"+dn$+".i=\\temp.i":close1
  85. 785 for t=1 to nl:fl$(t)="":next
  86. 790 goto 410
  87. 800 rem edit database
  88. 810 if of=0 then 1030
  89. 820 pd$=ul$:fc=1:nd=0:pl=tl
  90. 830 open1,dn,15:open3,dn,3,dn$+".d"
  91. 840 al=0:ky=0:nm=0:sp=0:gosub 5110:x=0:y=24:gosub2210:print tx$(4);
  92. 850 if ft(fc) and 1 then x=6:y=24:gosub 2210:print""+tx$(5)+"[146]";:al=1
  93. 860 if ft(fc) and 2 then x=12:y=24:gosub 2210:print""+tx$(6)+"[146]";:ky=1
  94. 870 if ft(fc) and 4 then x=16:y=24:gosub 2210:print""+tx$(7)+"[146]";:nm=1
  95. 880 if ft(fc) and 8 then x=20:y=24:gosub 2210:print""+tx$(8)+"[146]";:sp=1
  96. 885 x=sw-11:y=24:gosub 2210:print tx$(18);nr;
  97. 890 x=fx(fc):y=fy(fc):l=fl(fc):an$=ft$(fc)
  98. 900 print cr$(ec);
  99. 910 gosub 3430:t=fl(fc)-len(an$):ft$(fc)=an$+left$(pd$,t)
  100. 920 if a$=chr$(13) and fc=nf then 840
  101. 930 if a$="" or a$=chr$(13) then fc=fc+1:if fc>nf then fc=1
  102. 940 if a$="[145]" then fc=fc-1:if fc<1 then fc=nf
  103. 950 if ct=1 and asc(a$+chr$(0))=27 then a$=""
  104. 960 if a$="" then 1020
  105. 970 if a$=chr$(f1) then gosub 5310:fc=1:rem find rec
  106. 975 if a$=chr$(f2) then gosub 2110:fc=1:rem write rec
  107. 980 if a$=chr$(f3) then kf=1:gosub 1855:fc=1:rem first rec
  108. 985 if a$=chr$(f4) then kf=ix(0):gosub 1855:fc=1:rem last rec
  109. 990 if a$=chr$(f5) then gosub 1950:fc=1:rem read next
  110. 995 if a$=chr$(f6) then gosub 1850:fc=1:rem read prev
  111. 1000 if a$=chr$(f7) then gosub 4010:fc=1:rem clear form fields
  112. 1005 if a$=chr$(f8) then gosub 4060:fc=1:rem print form fields
  113. 1010 goto 840
  114. 1020 close3:close1
  115. 1030 gosub1696:goto430
  116. 1100 rem new database
  117. 1110 if of=1 then 450
  118. 1120 x=0:y=24:gosub2210:print tx$(2);:l=14:x=9:gosub 2320
  119. 1130 if a$="" then dn$="":goto 410
  120. 1140 if an$="" then 1120
  121. 1150 open 2,dn,2,an$+".f,u,r":gosub 5140:close2
  122. 1160 if en=0 then 1110
  123. 1170 if en<>62 then gosub 5060:goto 410
  124. 1180 nf=22:for t=1 to nf:fx(t)=0:fy(t)=t-1:fl(t)=sw-1:ft$(t)=left$(sp$,sw-2)+ss$
  125. 1190 x=fx(t):y=fy(t):gosub2210:print ft$(t);
  126. 1195 ft(t)=0:next:dn$=an$:gosub 2790:dn$="":goto 410
  127. 1200 rem open database
  128. 1210 if of=1 then 1500
  129. 1220 gosub 5110
  130. 1225 x=0:y=24:gosub2210:print tx$(2);:l=14:x=9:gosub 2320:if a$="" then 1500
  131. 1230 if an$="" then 1220
  132. 1240 open 2,dn,2,an$+".f,u,r":gosub 5140:close2:if en<>0 then 1220
  133. 1250 x=0:y=24:gosub2210:print tx$(13);
  134. 1260 tl=0:gosub 3310:if ef=-1 then 1220
  135. 1270 dn$=an$:open 2,dn,2,dn$+".i,u,r":gosub 5140:close2
  136. 1280 if en=0 then 1380
  137. 1290 if en<>62 then gosub 5060:goto 410
  138. 1300 rem create database
  139. 1310 gosub5110:x=0:y=24:gosub2210:print tx$(12);:l=4:x=23:gosub2320
  140. 1320 rn=val(an$):if rn=0 then 1310
  141. 1330 if rn>mr then rn=mr
  142. 1340 open 2,dn,2,dn$+".i,u,w":print#2,"indx";chr$(vn);chr$(0);chr$(0);:close2
  143. 1350 open1,dn,15:open3,dn,3,dn$+".d,l,"+chr$(tl):rh=fnh(rn):rl=fnl(rn)
  144. 1360 rp=1:gosub5010:print#3,chr$(255);:gosub 5010:close3:close1:gosub 5140
  145. 1370 rem read in database index,parms
  146. 1380 of=1:x=sw-22:y=22:gosub2210:printtx$(10);dn$;:t1=1
  147. 1390 for t=1 to nl:x=0:y=t-1:gosub 2210
  148. 1400 if ct=0 then print ft$(t);
  149. 1410 if ct=1 then print left$(ft$(t),sw-1);
  150. 1420 next:for t=1 to nf:t1=t1+fl(t):if(ft(t)and2)<>0 then kl=fl(t):kp=t1-kl:k1=t
  151. 1430 ft$(t)=left$(ul$,fl(t)):next:tl=t1-1
  152. 1440 open 2,dn,2,dn$+".i,u,r"
  153. 1450 get#2,a$,a$,a$,a$:get#2,a$:vn=asc(a$+chr$(0))
  154. 1460 get#2,a$,b$:nr=asc(a$+chr$(0))+(asc(b$+chr$(0))*256):ix(0)=nr
  155. 1470 if nr=0 then 1490
  156. 1480 for t=1 to nr:get#2,a$,b$:ix(t)=asc(a$+chr$(0))+(asc(b$+chr$(0))*256):next
  157. 1490 close2
  158. 1500 goto450
  159. 1600 rem utils database
  160. 1610 gosub 4210:goto 430
  161. 1612 rem select fields
  162. 1615 if of=0 then return
  163. 1620 pd$=sp$:fc=1:so=1:for t=1 to nf:fq(t)=0:fo(t)=0:next
  164. 1622 if fr=2 then x=0:y=23:gosub 2210:print"[211]elect field to search on               ";:goto 1630
  165. 1625 x=0:y=23:gosub 2210:print tx$(15);
  166. 1630 an$=ft$(fc):l=fl(fc):x=fx(fc):y=fy(fc)
  167. 1632 if fr=0 or fr=2 then 1638
  168. 1633 get a$:if a$="" then 1633
  169. 1634 if ct=1 and asc(a$+chr$(0))=27 then a$=""
  170. 1635 if a$="" then return
  171. 1636 goto 1633
  172. 1638 printcr$(ec);:gosub5200:printcr$(cc);
  173. 1640 if a$=chr$(13) and fq(fc)=0 then fq(fc)=so:fo(so)=fc:so=so+1:if fr=2 then fr=1
  174. 1645 if a$="" or a$=chr$(13) then fc=fc+1:if fc>nf then fc=1
  175. 1650 if a$="[145]" then fc=fc-1:if fc<1 then fc=nf
  176. 1655 if ct=1 and asc(a$+chr$(0))=27 then a$=""
  177. 1657 if a$="" then return
  178. 1659 goto 1630
  179. 1660 rem make usr file
  180. 1662 gosub5110:x=0:y=24:gosub 2210:print tx$(16);:l=1:y=24:x=11:gosub 2320
  181. 1665 if an$="n" or an$="[206]" or an$="y" or an$="[217]" then 1675
  182. 1667 goto 1660
  183. 1670 rem build output records
  184. 1675 gosub 6010
  185. 1680 rem sort records
  186. 1685 if an$="y" or an$="[217]" then gosub 7010
  187. 1690 rem output export file
  188. 1691 if c=4 then gosub 8310
  189. 1692 if c=5 then gosub 8210
  190. 1695 if c=6